home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / vis082s.arc / SUBS3.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1991-04-18  |  4.9 KB  |  177 lines
  1.  
  2. unit subs3;
  3.  
  4. interface
  5.  
  6. uses crt,dos,
  7.      gentypes,configrt,modem,statret,gensubs,subs1,windows,subs2,textret,
  8.      mailret,userret,flags,mainr1,ansiedit,lineedit,chatstuf,
  9.      mainr2,overret1,mainmenu;
  10.  
  11. procedure arcview (fname:lstr);
  12. procedure pakview (filename:lstr);
  13. procedure zipview (fn:lstr);
  14. procedure lzhview (fn:lstr);
  15. procedure addszlog(cps:sstr;fname:lstr;send:boolean;size:longint);
  16. procedure leechzmodem(filezp:mstr);
  17. procedure addzipcomment(pathname:lstr;path,name:mstr);
  18.  
  19. implementation
  20.  
  21. procedure arcview (fname:lstr);
  22. var f:file of byte;
  23.     b:byte;
  24.     sg:boolean;
  25.     size:longint;
  26.     n:integer;
  27.  
  28. function getsize:longint;
  29. var x:longint;
  30.     b:array [1..4] of byte absolute x;
  31.     cnt:integer;
  32. begin
  33.  for cnt:=1 to 4 do read (f,b[cnt]);
  34.  getsize:=x
  35. end;
  36.  
  37. begin
  38.  writeln('PKARC');
  39.  assign (f,fname);
  40.  reset (f);
  41.  iocode:=ioresult;
  42.  if iocode<>0 then begin
  43.   fileerror ('LISTARCHIVE',fname);
  44.   exit;
  45.  end;
  46.  if (filesize(f)<32) then begin
  47.   writeln (^M'That file isn''t an archive!');
  48.   close (f);
  49.   exit;
  50.  end;
  51.  writeln ('Filename.Ext    Size');
  52.  if (asciigraphics in urec.config) then
  53.  writeln ('────────────    ────') else
  54.  writeln ('------------    ----');
  55.  repeat
  56.   read (f,b);
  57.   if b<>26 then begin
  58.    writeln (^M'That file isn''t an archive!');
  59.    close (f);
  60.    exit
  61.   end;
  62.   read (f,b);
  63.   if b=0 then begin
  64.    close (f);
  65.    exit
  66.   end;
  67.   sg:=false;
  68.   for n:=1 to 13 do begin
  69.    read (f,b);
  70.    if b=0 then sg:=true;
  71.    if sg then b:=32;
  72.    write (chr(b))
  73.   end;
  74.   size:=getsize;
  75.   for n:=1 to 6 do read (f,b);
  76.   writeln ('   ',getsize);
  77.   seek (f,filepos(f)+size)
  78.  until break or hungupon;
  79. end;
  80.  
  81. procedure pakview (filename:lstr);
  82. var f:file of byte;
  83. begin
  84.  writeln('PKPAK');
  85.  if not exist ('pkpak') then begin
  86.   writeln (^M'Error: PK-Pak not found. Notify Sysop.'^M);
  87.   exit;
  88.  end;
  89.  exec (getenv('COMSPEC'),'/C pkpak v '+filename+' >PAK.LST');
  90.  printfile ('PAK.LST')
  91. end;
  92.  
  93. procedure zipview (fn:lstr);
  94.  
  95. begin
  96. writeln('PKZIP');
  97. exec(getenv('Comspec'),'/C Pkunzip -v -q '+fn+' >'+configset.forumdi+'Zipfil.lst');
  98. printfile(configset.forumdi+'Zipfil.lst');
  99. end;
  100.  
  101. procedure lzhview(fn:lstr);
  102. begin
  103. if pos('.ICE',upstring(fn))>0 then writeln('LH-ICE') else writeln('LH-ARC');
  104. swapvectors;
  105. exec(getenv('Comspec'),'/C LHARC /v '+fn+' >'+configset.forumdi+'Zipfil.lst');
  106. swapvectors;
  107. printfile(configset.forumdi+'Zipfil.Lst');
  108. end;
  109.  
  110.  procedure addszlog(cps:sstr;fname:lstr;send:boolean; size:longint);
  111.  var f:file of byte;
  112.      t:text;
  113.      fse:longint;
  114.  begin
  115.  fse:=0;
  116.     if exist(configset.forumdi+'Trans.Log') then begin
  117.        assign(f,configset.forumdi+'Trans.Log');   reset(f);
  118.        fse:=filesize(f);
  119.        close(f);
  120.     end;
  121.     if (fse=0) or (fse>(1024+(configset.logsize*1024))) then begin
  122.        assign(t,configset.forumdi+'Trans.Log');
  123.        rewrite(t);
  124.        writeln(t,'ViSiON File Transfer InfoLog (tm) 1991 Ruthless Enterprises');
  125.        writeln(t,'File Name                                        CPS  Upload or Download');
  126.        writeln(t,'════════════════════════════════════════════════════════════════════════');
  127.        textclose(t);
  128.     end;
  129.     assign(t,configset.forumdi+'Trans.Log');
  130.     append(t);
  131.     write(t,copy(fname,0,50));
  132.     for fse:=1 to 50-length(fname) do write(t,' ');
  133.     write(t,cps);
  134.     write(t,' '+copy(strr(size div 1024)+'k ',0,5));
  135.     if send then writeln(t,'Download') else writeln(t,'Upload');
  136.     textclose(t);
  137.  end;
  138.  
  139.  procedure leechzmodem(filezp:mstr);
  140.  var fn:text;
  141.      i:integer;
  142.  begin
  143.  clearscr;
  144.  writehdr('Leech Z-Modem Detected!');
  145.  writeln(^M^S'Leech Z-Modem has been detected with this file transfer! The');
  146.  writeln(^S'File points will be subtracted and the sysop WILL be notified!');
  147.  write(^M^R'Notifying Sysop...');
  148.  assign(fn,configset.forumdi+'Notices.BBS');
  149.  if not exist(configset.forumdi+'Notices.BBS') then rewrite(fn) else reset(fn);
  150.  append(fn);
  151.  writeln(fn,^M^S'───────────────────────────────────────────────────────────────────────');
  152.  writeln(fn,^R'                         Leech Z-Modem Detected');
  153.  writeln(fn,^S'───────────────────────────────────────────────────────────────────────');
  154.  writeln(fn,^M^S+urec.handle+' was downloading on '+timestr(now)+'/'+datestr(now)+' when he');
  155.  writeln(fn,^S'attempted to use Leech Z-Modem on '+filezp+'. The Points were');
  156.  writeln(fn,^S'charged for this file.');
  157.  textclose(fn);
  158.  end;
  159.  
  160.  
  161. procedure addzipcomment(pathname:lstr; path,name:mstr);
  162.     begin
  163.     if not configset.usezip then exit;
  164.          if pos('.ZIP',upstring(name))>0 then begin
  165.          writehdr(' Demon Tasker... Adding Zip Comment... ');
  166.          exec(getenv('Comspec'),'/C Pkzip -z '+pathname+' <'+configset.textfiledi+'zipcomnt.txt');
  167.          if configset.pathfnme<>'' then
  168.          exec(getenv('Comspec'),'/C PKZIP '+pathname+' '+configset.pathfnme);
  169.          writeln(^M'Done!');
  170.          end;
  171.     end;
  172.  
  173.  
  174. begin
  175. end.
  176.  
  177.